BackForward

/*-------------------<-- Start of Description-->---------------------\
| List repeated formula based on the number of variables; basically  |
| it replace the "vars" in the formula you listed with the variables |
| you listed respectively;                                           |
|---------------------<-- End of Description-->----------------------|
|--------------------------------------------------------------------|
|-----------<-- Start of Files or Arguements Needed-->---------------|
| Arguments:                                                         |
|    var - list of variable names;                                   |
|    formula - the formula you want to list.                         |
|    logic - the logic operator you want about these formulas;       |
|-----------------<-- End of Arguements Needed-->--------------------|
|--------------------------------------------------------------------|
|------------------<-- Start of Files Created-->---------------------|
| Example: %put %listfml(var=var1 var3 var4-var10 test,              |
|          formula=(index(upcase(vars), 'TEST') >= 1), logic=or);    |
| Usage:   %listfml(var=, formula=, logic=);                         |
\-------------------<-- End of Files Created-->---------------------*/
%macro listfml(var=, formula=, logic=);
/*--------------------------------------------\
| Copy Right: Duo Zhou;                       |
| Created: 10-15-2002 9:54pm;                 |
\--------------------------------------------*/
%local _allfmls_ _fmlvar_ _jvar_ _varj_ _fmlj_;
%let _allfmls_=;
%if (%length(%bquote(&var)) gt 0) %then %do;
   %if (%index(%quote(&var), %quote(,))) %then %let _vardlm_=%quote(,);
   %else %let _vardlm_=%quote( );
   /*Add some code to recognize the format of var10-var20, replace with var10 var11 ... var20*/
   %if (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&var))))), %str(%()) eq 1) and
          (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(%sysfunc(reverse(&var))))))), %str(%))) eq 1) %then %do;
      %let var=%substr(%quote(%trim(%left(&var))), 2, %eval(%length(%quote(%trim(%left(&var))))-2));
   %end;
   %if (%index(%quote(%upcase(&formula)), %str(VARS))) %then %let _fmlvar_=%substr(&formula, (%index(%quote(%upcase(&formula)), %quote(VARS))), %length(VARS));
   %else %if (%index(%quote(%upcase(&formula)), %str(VAR))) %then %let _fmlvar_=%substr(&formula, (%index(%quote(%upcase(&formula)), %quote(VAR))), %length(VAR));
   %if (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&formula))))), %str(%()) ne 1) or
          (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(%sysfunc(reverse(&formula))))))), %str(%))) ne 1) %then %do;
      %let formula=(&formula);
   %end;
   %if (%sysfunc(index(%quote(&var),_ALL_))) %then %let var=*;
   %else %if (%sysfunc(index(%quote(%upcase(&var)),_CHARACTER_))) %then %do;
      %if (%sysfunc(exist(&indata))) %then %do;
         %let _indsid_=%sysfunc(open(&indata)); %let _innvars_=%sysfunc(attrn(&_indsid_,NVARS));
         %let _convar_=;
         %do _invari_=1 %to &_innvars_;
            %let _invtype_=%sysfunc(vartype(&_indsid_, &_invari_));
            %if (not %index(%quote(%upcase(&_invtype_)),%quote(N))) %then %do;
               %let _convar_= %trim(%left(&_convar_)) %sysfunc(varname(&_indsid_,&_invari_));
            %end;
         %end;
         %let _invrc_=%sysfunc(close(&_indsid_)); %let var=&_convar_;
      %end;
   %end;
   %else %if (%sysfunc(index(%quote(%upcase(&var)),_NUMERIC_))) %then %do;
      %if (%sysfunc(exist(&indata))) %then %do;
         %let _indsid_=%sysfunc(open(&indata)); %let _innvars_=%sysfunc(attrn(&_indsid_,NVARS));
         %let _convar_=;
         %do _invari_=1 %to &_innvars_;
            %let _invtype_=%sysfunc(vartype(&_indsid_, &_invari_));
            %if (%index(%quote(&_invtype_),%quote(N))) %then %do;
               %let _convar_= %trim(%left(&_convar_)) %sysfunc(varname(&_indsid_,&_invari_));
            %end;
         %end;
         %let _invrc_=%sysfunc(close(&_indsid_)); %let var=&_convar_;
      %end;
   %end;
   %else %do;
      %let _convar_=;
      %do %while(%index(%quote(&var), %str(-)));
         %let _sub1var_=%substr(%quote(&var), 1, %eval(%index(%quote(&var), %str(-))-1));
         %let var=%substr(%quote(&var), %eval(%index(%quote(&var), %str(-))+1), %eval(%length(&var)-%index(%quote(&var), %str(-))));
         %let _tmpvari_=0;
         %do %while(%length(%nrbquote(%scan(%nrbquote(&_sub1var_), %eval(&_tmpvari_+1), %nrbquote(&_vardlm_)))));
            %let _tmpvari_=%eval(&_tmpvari_+1);
            %let _tmp1var_=%nrbquote(%qscan(%nrbquote(&_sub1var_), &_tmpvari_, %%nrbquote(&_vardlm_)));
            %if (%length(%nrbquote(%scan(%nrbquote(&_sub1var_), %eval(&_tmpvari_+1), %nrbquote(&_vardlm_))))) %then %do;
               %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_))));
               %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_))));
            %end;
            %else %if ( %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_)))+1)) %then %do;
               %let _arrvarbeg_=%substr(%quote(&_tmp1var_), %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_)))+1), %eval(%length(&_tmp1var_)- %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_))))));
               %if (%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_))) ge 1) %then
                  %let _arrvarbroot_=%substr(%quote(&_tmp1var_), 1, %sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_))));
               %else %let _arrvarbroot_=;
               %if (%quote(&var) ne) %then %do;
                  %let _tmp2var_=%nrbquote(%qscan(%nrbquote(&var), 1, %%nrbquote(&_vardlm_)));
                  %if (%sysfunc(rxmatch(%sysfunc(rxparse($d $s)),&_tmp2var_))) %then %do;
                     %let _arrvarend_=%substr(%quote(&_tmp2var_), %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp2var_)))+1), %eval(%length(&_tmp2var_)- %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp2var_))))));
                     %if (%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp2var_))) ge 1) %then
                        %let _arrvareroot_=%substr(%quote(&_tmp2var_), 1,%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp2var_))));
                     %else %let _arrvareroot_=;
                     %if (%quote(&_arrvarbroot_) eq %quote(&_arrvareroot_)) %then %do;
                        %do _locali_=&_arrvarbeg_ %to %eval(&_arrvarend_-1);
                           %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%left(&_arrvarbroot_))%trim(%left(&_locali_));
                           %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%left(&_arrvarbroot_))%trim(%left(&_locali_));
                        %end;
                     %end;
                     %else %do;
                        %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_))));
                        %else %let _convar_=%trim(%quote(%left(&_convar_)))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_))));
                        %put ==> Alert! Variable name &_tmp1var_ and &_tmp2var_ do not have the same pattern!;
                     %end;
                  %end;
                  %else %do;
                     %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_))));
                     %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_))));
                     %put ==> Alert! Variable name &_tmp2var_ does not have a numeric suffix!;
                  %end;
               %end;
               %else %do;
                  %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_))));
                  %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_))));
                  %put ==> Alert! No variable names are provided after &_tmp1var_ -!;
               %end;
            %end;
            %else %do;
               %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_))));
               %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_))));
               %put ==> Alert! Variable name &_tmp1var_ does not have a numeric suffix!;
            %end;
         %end;
      %end;
      %let var=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&var))));
   %end;
   /*End of change*/
   %let _jvar_=0;
   %do %while(%length(%quote(%qscan(%quote(&var), %eval(&_jvar_+1), %quote(&_vardlm_)))));
      %let _jvar_=%eval(&_jvar_+1);
      %let _varj_=%qscan(%quote(&var), &_jvar_, %quote(&_vardlm_));
      %let _fmlj_=%sysfunc(tranwrd(%quote(&formula), %quote(&_fmlvar_), %quote(&_varj_)));
      %if (%quote(&_jvar_) eq 1) %then %let _allfmls_=&_fmlj_;
      %else %if (%length(&_varj_) gt 0) %then %let _allfmls_=%trim(%bquote(%left(%bquote(&_allfmls_)))) &logic %trim(%bquote(%left(%bquote(&_fmlj_))));
   %end;
%end; &_allfmls_
%mend listfml;